*DECK DPLPQX
      SUBROUTINE DPLPQX (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  DPLPQX
C***PURPOSE  Quick check for DSPLP.
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (SPLPQX-S, DPLPQX-D)
C***AUTHOR  (UNKNOWN)
C***ROUTINES CALLED  DCOPY, DSPLP, DUSRMT, PASS
C***REVISION HISTORY  (YYMMDD)
C   ??????  DATE WRITTEN
C   890911  Removed unnecessary intrinsics.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   901013  Added additional printout on failure.  (RWC)
C***END PROLOGUE  DPLPQX
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      EXTERNAL DUSRMT
      INTEGER ICNT, IND(60), IBASIS(60), IPASS, IWORK(900), ISOLN(14)
      DOUBLE PRECISION COSTS(37)
      DOUBLE PRECISION PRGOPT(50), DATTRV(210), BL(60), BU(60)
      DOUBLE PRECISION PRIMAL(60), DUALS(60)
      DOUBLE PRECISION WORK(800)
      DOUBLE PRECISION D(14,37)
      DOUBLE PRECISION ZERO
      INTEGER MRELAS,NVARS,INFO,LW,LIW
C***FIRST EXECUTABLE STATEMENT  DPLPQX
      IF(KPRINT.GE.2) WRITE(LUN,999)
  999 FORMAT ('1 DSPLP QUICK CHECK')
      ICNT=1
      ZERO = 0.0D0
      IPASS=0
C     DEFINE WORKING ARRAY LENGTHS
      LIW = 900
      LW = 800
      MRELAS = 14
      NVARS = 37
C     DEFINE THE ARRAY COSTS(*) FOR THE OBJECTIVE FUNCTION
      COSTS(1) = 1.030D0
      COSTS(2) = 0.985D0
      COSTS(3) = 0.997D0
      COSTS(4) = 1.036D0
      COSTS(5) = 1.005D0
      COSTS(6) = 0.980D0
      COSTS(7) = 1.004D0
      COSTS(8) = 0.993D0
      COSTS(9) = 1.018D0
      COSTS(10) = 0.947D0
      COSTS(11) = 0.910D0
      COSTS(12) = 1.028D0
      COSTS(13) = 0.957D0
      COSTS(14) = 1.025D0
      COSTS(15) = 1.036D0
      COSTS(16) = 1.060D0
      COSTS(17) = 0.954D0
      COSTS(18) = 0.891D0
      COSTS(19) = 0.921D0
      COSTS(20) = 1.040D0
      COSTS(21) = 0.912D0
      COSTS(22) = 0.926D0
      COSTS(23) = 1.000D0
      COSTS(24) = 0.000D0
      COSTS(25) = 0.000D0
      COSTS(26) = 0.000D0
      COSTS(27) = 0.000D0
      COSTS(28) = 0.000D0
      COSTS(29) = 0.000D0
      COSTS(30) = 0.000D0
      COSTS(31) = 0.000D0
      COSTS(32) = 0.000D0
      COSTS(33) = 0.000D0
      COSTS(34) = 0.000D0
      COSTS(35) = 0.000D0
      COSTS(36) = 0.000D0
      COSTS(37) = 0.000D0
C     PLACE THE NONZERO INFORMATION ABOUT THE MATRIX IN DATTRV(*)
      CALL DCOPY(14*37, ZERO, 0, D, 1)
      D(1,1) = 1.04000D0
      D(1,23) = 1.00000D0
      D(1,24) = -1.00000D0
      D(2,6) = 0.04125D0
      D(2,7) = 0.05250D0
      D(2,17) = 0.04875D0
      D(2,24) = 1.00000D0
      D(2,25) = -1.00000D0
      D(3,8) = 0.05625D0
      D(3,9) = 0.06875D0
      D(3,11) = 0.02250D0
      D(3,25) = 1.00000D0
      D(3,26) = -1.00000D0
      D(4,2) = 1.04000D0
      D(4,3) = 1.05375D0
      D(4,5) = 1.06125D0
      D(4,12) = 0.08000D0
      D(4,16) = 0.09375D0
      D(4,18) = 0.03750D0
      D(4,19) = 0.04625D0
      D(4,20) = 0.08125D0
      D(4,22) = 0.05250D0
      D(4,26) = 1.00000D0
      D(4,27) = -1.00000D0
      D(5,10) = 0.04375D0
      D(5,27) = 1.00000D0
      D(5,28) = -1.00000D0
      D(6,4) = 1.05875D0
      D(6,13) = 0.04500D0
      D(6,14) = 0.06375D0
      D(6,15) = 0.06625D0
      D(6,21) = 0.05000D0
      D(6,28) = 1.00000D0
      D(6,29) = -1.00000D0
      D(7,6) = 1.04125D0
      D(7,7) = 1.05250D0
      D(7,8) = 1.05625D0
      D(7,9) = 1.06875D0
      D(7,11) = 0.02250D0
      D(7,17) = 0.04875D0
      D(7,29) = 1.00000D0
      D(7,30) = -1.00000D0
      D(8,10) = 1.04375D0
      D(8,12) = 0.08000D0
      D(8,13) = 0.04500D0
      D(8,14) = 0.06375D0
      D(8,15) = 0.06625D0
      D(8,16) = 0.09375D0
      D(8,18) = 0.03750D0
      D(8,19) = 0.04625D0
      D(8,20) = 0.08125D0
      D(8,21) = 0.05000D0
      D(8,22) = 0.05250D0
      D(8,30) = 1.00000D0
      D(8,31) = -1.00000D0
      D(9,11) = 1.02250D0
      D(9,17) = 0.04875D0
      D(9,31) = 1.00000D0
      D(9,32) = -1.00000D0
      D(10,12) = 1.08000D0
      D(10,13) = 1.04500D0
      D(10,14) = 1.06375D0
      D(10,15) = 1.06625D0
      D(10,16) = 1.09375D0
      D(10,18) = 0.03750D0
      D(10,19) = 0.04625D0
      D(10,20) = 0.08125D0
      D(10,21) = 0.05000D0
      D(10,22) = 0.05250D0
      D(10,32) = 1.00000D0
      D(10,33) = -1.00000D0
      D(11,17) = 1.04875D0
      D(11,33) = 1.00000D0
      D(11,34) = -1.00000D0
      D(12,18) = 1.03750D0
      D(12,19) = 1.04625D0
      D(12,20) = 1.08125D0
      D(12,21) = 1.05000D0
      D(12,22) = 0.05250D0
      D(12,34) = 1.00000D0
      D(12,35) = -1.00000D0
      D(13,35) = 1.00000D0
      D(13,36) = -1.00000D0
      D(14,22) = 1.05250D0
      D(14,36) = 1.00000D0
      D(14,37) = -1.00000D0
      KOUNT = 1
      DO 20 MM=1,NVARS
        DATTRV(KOUNT) = -MM
        DO 10 KK=1,MRELAS
          IF (D(KK,MM).EQ.ZERO) GO TO 10
          KOUNT = KOUNT + 1
          DATTRV(KOUNT) = KK
          KOUNT = KOUNT + 1
          DATTRV(KOUNT) = D(KK,MM)
   10   CONTINUE
        KOUNT = KOUNT + 1
   20 CONTINUE
      DATTRV(KOUNT) = ZERO
C     NON-NEGATIVITY CONSTRAINT
      DO 30 IC=1,NVARS
        BL(IC) = ZERO
        IND(IC) = 3
        BU(IC) = 10000000.000D0
   30 CONTINUE
C     LE CONSTRAINTS
      DO 40 IV=1,MRELAS
        IVV = IV + NVARS
        IND(IVV) = 3
        BL(IVV) = 100.00000D0
        BU(IVV) = 100000000.00000D0
   40 CONTINUE
      PRGOPT(01) = 18
      PRGOPT(02) = 59
      PRGOPT(03) = 0
      PRGOPT(04) = 1
      PRGOPT(05) = 3
      PRGOPT(06) = 8
      PRGOPT(07) = 10
      PRGOPT(08) = 11
      PRGOPT(09) = 16
      PRGOPT(10) = 17
      PRGOPT(11) = 21
      PRGOPT(12) = 22
      PRGOPT(13) = 24
      PRGOPT(14) = 25
      PRGOPT(15) = 27
      PRGOPT(16) = 28
      PRGOPT(17) = 35
      PRGOPT(18) = 21
      PRGOPT(19) = 51
      PRGOPT(20) = 0
      PRGOPT(21) = 1
      CALL DSPLP(DUSRMT, MRELAS, NVARS, COSTS, PRGOPT, DATTRV, BL,
     * BU, IND, INFO, PRIMAL, DUALS, IBASIS, WORK, LW, IWORK, LIW)
C
C     LOOK FOR THE KNOWN BASIS AT THE SOLN., NOW IS ISOLN(*).
C
      DO 50 I=1,MRELAS
         ISOLN(I) = PRGOPT(I+3)
   50 CONTINUE
C
      IPASS = 1
      DO 70 J=1,MRELAS
         DO 60 I=1,MRELAS
            IF (ISOLN(I).EQ.IBASIS(J)) GO TO 70
   60    CONTINUE
         IPASS = 0
         GO TO 80
   70 CONTINUE
C
   80 IF (KPRINT.GE.2) WRITE (LUN, 99997) (ISOLN(I), IBASIS(I),
     *   I=1,MRELAS)
C
      IF (KPRINT.GE.2 .OR. (KPRINT.EQ.1.AND.IPASS.NE.1))
     *   CALL PASS (LUN, ICNT, IPASS)
C
C     HERE IPASS=0 IF CODE FAILED QUICK CHECK;
C               =1 IF CODE PASSED QUICK CHECK.
C
      IF (KPRINT.GE.1 .AND. IPASS.NE.1) WRITE (LUN,99999)
      IF (KPRINT.GE.2 .AND. IPASS.EQ.1) WRITE (LUN,99998)
      RETURN
C
99997 FORMAT (/'     ISOLN    IBASIS'/(2I10))
99998 FORMAT (/' ************ DSPLP PASSED ALL TESTS ****************')
99999 FORMAT (/' ************ DSPLP FAILED SOME TESTS ***************')
      END
